> module CHF.CoreL.MachineLanguage where
> import CHF.Parse.Parser
> import CHF.CoreL.Language
> import CHF.SemAna.TypeCheck
> import Data.List
> import Debug.Trace
> import qualified Data.Map as Map

> type Mark1Expr = MExpr Mark1Cons Mark1Var
> type Mark1Var  = String
> type Mark1Cons = String

> data MExpr cname v =
>     VarM v                        
>   | LamM v (MExpr cname v)
>   | AppM (MExpr cname v) v
>   | SeqM (MExpr cname v) v
>   | ConsM (Either MAction cname) [v]
>   | CaseM (MExpr cname v) [MCAlt cname v]
>   | LetrecM [MBinding cname v] (MExpr cname v)
>  deriving(Eq,Show)



> data MCAlt cname v = 
>  CAltM cname [v] (MExpr cname v)
>  deriving(Eq,Show)

> data MBinding cname v = 
>  v := (MExpr cname v)
>  deriving(Eq,Show)


> -- | 'substitude' benennt jedes vorkommen von v1 im ausdruck in v2 um.
> substitute :: Mark1Expr -> Mark1Var -> Mark1Var -> Mark1Expr
> substitute (VarM v) v1 v2		=  if v==v1 then (VarM v2) else (VarM v) 
> substitute (LamM v e) v1 v2	=  if v==v1 then (LamM v2 (substitute e v1 v2)) else (LamM v (substitute e v1 v2)) 
> substitute (AppM  e v) v1 v2	=  if v==v1 then (AppM  (substitute e v1 v2) v2) else (AppM  (substitute e v1 v2) v)
> substitute (SeqM  e v) v1 v2	=  if v==v1 then (SeqM  (substitute e v1 v2) v2) else (SeqM  (substitute e v1 v2) v)
> substitute (ConsM cname arg) v1 v2 = (ConsM cname (substituteVarlist arg v1 v2))
> --substitute (ConsM (Left a) arg) v1 v2 = (ConsM (Left a) arg)
> substitute (CaseM e calts) v1 v2 = CaseM (substitute e v1 v2) (substituteCalts calts v1 v2)
> substitute (LetrecM  binds e) v1 v2 = LetrecM  (substituteBinds binds v1 v2)   (substitute e v1 v2) 

> -- | 'substitudeVarlist' durchlaeuft die variablenliste eines const-ausdrucks
> substituteVarlist [] v1 v2 = []
> substituteVarlist [(v)] v1 v2 = if v == v1 then [v2] else [v]
> substituteVarlist (v:vs) v1 v2 = case v == v1 of 
>										True -> [v2] ++ (substituteVarlist vs v1 v2)
>										False -> [v] ++ (substituteVarlist vs v1 v2)

> -- | 'substitudeCalts' verarbeitet die Case-Ausdruecke
> substituteCalts [] v1 v2 = []
> substituteCalts [(CAltM cname v e)] v1 v2 = [(CAltM cname (substituteVarlist v v1 v2) (substitute e v1 v2))]
> substituteCalts ((CAltM cname v e) : alts) v1 v2 = [(CAltM cname (substituteVarlist v v1 v2) (substitute e v1 v2))] ++ substituteCalts alts v1 v2

> -- | 'substitudeBinds' verarbeitet die Letrec-Bindungen
> substituteBinds [] v1 v2 = []
> substituteBinds [(v := e)] v1 v2 = [((substituteVar v v1 v2) := (substitute e v1 v2))]
> substituteBinds ((v := e):binds) v1 v2 = [((substituteVar v v1 v2) := (substitute e v1 v2))] ++ substituteBinds binds v1 v2

> -- | 'substitudeVar' verabeitet die linke Seite einer Bindung
> substituteVar v v1 v2= if v==v1 then v2 else v 